perm filename SAYIII.SAI[11,ALS] blob sn#049081 filedate 1973-06-14 generic text, type T, neo UTF8
00100	COMMENT ⊗   VALID 00002 PAGES 
00200	RECORD PAGE   DESCRIPTION
00300	 00001 00001
00400	 00002 00002	BEGIN "SAY"
00500	 00007 ENDMK
00600	⊗;
     

00100	BEGIN "SAY"
00200	DEFINE ⊂="COMMENT";  ⊂ 5/28/73 Runs SIG from FIX output;
00210	⊂ MODIFIED TO GATE INPUT TABLES ON FEATURES JUNE 7 1973;
00250	⊂ This version smooths data using routine update after each ripple;
00300	REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00400	REQUIRE "SIGIII" LOAD_MODULE;
00500		REQUIRE "BLOCKS.HDR" SOURCE_FILE;
00600	EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00700	INTEGER ARRAY LFILE[0:'177];
00800	INTERNAL INTEGER ARRAY INDATA[0:4000];
00900	INTERNAL INTEGER H,I,J,K,L,M,N,P,NF;
01000	INTERNAL INTEGER FLAG,TFLAG,UPCNT;
01100	INTERNAL INTEGER SEGC,INTOT,SEGTOT,HINT,BPT,INFLAG;
01200	INTEGER HINCNT,HCOUNT,HINDEX,EOF,EOFA,BRK;
01300	STRING PREHINT;
01400	INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5;
01500	STRING READ1,FILEL,FILEI,TFILE,TFILEI,FILLST;
01600	LABEL START,ZZZZ,ZZZ,ZZ;
01602	DEFINE ⊂="COMMENT",CR="'15",LF="'12",TB="'11";
01604	DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
01606	BOOLEAN ER;
01608	
01610	INTEGER EOFB,RL;
01612	INTERNAL INTEGER STX,STXX;
01614	STRING FILSTR,SNAMES,SNAME;
01616	
01620	INTEGER RETAIN; STRING OPT2;
01622	PRELOAD_WITH
01624	'777777777760,
01626	'377775777760,
01628	'177774777760,
01630	'077774377760,
01632	'037774177760,
01634	'017774077760,
01636	'007774037760,
01638	'003774017760,
01640	'001774007760;
01642	INTEGER ARRAY MASKP[0:8];
01644	PRELOAD_WITH
01646	'777777777777,
01648	'377776000000,
01650	'177776000000,
01652	'077776000000,
01654	'037776000000,
01656	'017776000000,
01658	'007776000000,
01660	'003776000000,
01662	'001776000000;
01664	INTEGER ARRAY MASKQ1[0:8];
01666	
01668	PRELOAD_WITH
01670	'777777777777,
01672	'377377377377,
01674	'177177177177,
01676	'077077077077,
01678	'037037037037,
01680	'017017017017,
01682	'007007007007,
01684	'003003003003,
01686	'001001001001;
01688	INTEGER ARRAY MASKQ2[0:8];
02049	
02050	INTEGER PROCEDURE UPDATE;
02052	BEGIN "UPDATE"
02054	
02056	COMMENT This procedure smooths the output values by adding data
02058	taken from adjacent entries. At the present the central location
02060	data is weighted 8 to 1 for the 4 nearest neighbors for
02062	P2 tables and 16 to 1 for the 6 nearest neighbors for P3
02064	tables.  This routine works only for P tables;
02066	
02068	INTEGER I,J,K,L,M,N,P,Q,R,Z;
02070	INTEGER GOOD,BAD,PLACE;
02072	
02074	
02076	FOR I←STXX+10 STEP 74 UNTIL STX-64 DO BEGIN
02078	
02079	  IF TABLES[I-9]=0 THEN DONE;
02080	  PLACE←POINT(3,TABLES[I-9],5);
02082	
02084	  IF PLACE=2 THEN BEGIN
02086	
02088	  FOR J←0 STEP 1 UNTIL 7 DO
02090	    FOR K←0 STEP 1 UNTIL 7 DO BEGIN
02092	      N←J*8+K;
02094	      GOOD←POINT(16,TABLES[I+N],31);
02096	      L←LDB(GOOD);
02098	      BAD←POINT(16,TABLES[I+N],15);
02100	      Z←L+LDB(BAD);
02102	
02104	      L←L LSH 3; Z←Z LSH 3;
02106	
02108	      IF J>0 THEN BEGIN
02110	      GOOD←POINT(16,TABLES[I+N-8],31); L←L+LDB(GOOD);
02112	      BAD←POINT(16,TABLES[I+N-8],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02114	
02116	      IF J<7 THEN BEGIN
02118	      GOOD←POINT(16,TABLES[I+N+8],31); L←L+LDB(GOOD);
02120	      BAD←POINT(16,TABLES[I+N+8],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02122	
02124	      IF K>0 THEN BEGIN
02126	      GOOD←POINT(16,TABLES[I+N-1],31); L←L+LDB(GOOD);
02128	      BAD←POINT(16,TABLES[I+N-1],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02130	
02132	      IF K<7 THEN BEGIN
02134	      GOOD←POINT(16,TABLES[I+N+1],31); L←L+LDB(GOOD);
02136	      BAD←POINT(16,TABLES[I+N+1],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02138	
02140	      M←((L LSH 4)/Z+1)/2; IF M≥8 THEN M←7;
02142	
02144	      Q←POINT(32,TABLES[I+N],31);
02146	      TABLES[I+N]←(LDB(Q) LSH 4)+M;
02148	
02150	      END;
02152	
02154	  END ELSE IF PLACE =3 THEN BEGIN
02156	
02158	  FOR J←0 STEP 1 UNTIL 3 DO
02160	    FOR K←0 STEP 1 UNTIL 3 DO BEGIN
02162	      R←J*4+K;
02164	      FOR P←0 STEP 1 UNTIL 3 DO BEGIN
02166	        N←R*4+P;
02168	        GOOD←POINT(16,TABLES[I+N],31);
02170	        L←LDB(GOOD);
02172	        BAD←POINT(16,TABLES[I+N],15);
02174	        Z←L+LDB(BAD);
02176	
02178	        L←L LSH 4; Z←Z LSH 4;
02180	
02182	        IF J>0 THEN BEGIN
02184	        GOOD←POINT(16,TABLES[I+N-16],31); L←L+LDB(GOOD);
02186	        BAD←POINT(16,TABLES[I+N-16],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02188	
02190	        IF J<3 THEN BEGIN
02192	        GOOD←POINT(16,TABLES[I+N+16],31); L←L+LDB(GOOD);
02194	        BAD←POINT(16,TABLES[I+N+16],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02196	
02198	        IF K>0 THEN BEGIN
02200	        GOOD←POINT(16,TABLES[I+N-4],31); L←L+LDB(GOOD);
02202	        BAD←POINT(16,TABLES[I+N-4],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02204	
02206	        IF K<3 THEN BEGIN
02208	        GOOD←POINT(16,TABLES[I+N+4],31); L←L+LDB(GOOD);
02210	        BAD←POINT(16,TABLES[I+N+4],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02212	
02214	        IF P>0 THEN BEGIN
02216	        GOOD←POINT(16,TABLES[I+N-1],31); L←L+LDB(GOOD);
02218	        BAD←POINT(16,TABLES[I+N-1],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02220	
02222	        IF P<3 THEN BEGIN
02224	        GOOD←POINT(16,TABLES[I+N+1],31); L←L+LDB(GOOD);
02226	        BAD←POINT(16,TABLES[I+N+1],15); Z←Z+LDB(BAD)+LDB(GOOD); END;
02228	
02230	        M←((L LSH 4)/Z+1)/2; IF M≥8 THEN M←7;
02232	        Q←POINT(32,TABLES[I+N],31);
02234	        TABLES[I+N]←(LDB(Q) LSH 4)+M;
02236	
02238	        END;
02240	      END;
02242	
02244	  END;
02246	
02248	END;
02250	
02252	END "UPDATE";
02280	
02290	STRING PROCEDURE HEADER;
02295	  BEGIN "HEADER"
02300	  STRING H1,H2; INTEGER I,J,K;
02305	  IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; HINCNT←HINCNT+1; RETURN(PREHINT) END 
02310	  ELSE WHILE HCOUNT=0 DO BEGIN "XX"
02315	  I←LFILE[HINDEX];  K←LDB(POINT(12,I,23)); J←SEGC-K; 
02320	  IF I=0 THEN BEGIN PREHINT←"NU"; HCOUNT←999; RETURN(PREHINT) END;
02325	  IF J ≥ 0 THEN BEGIN "LATCH"   H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
02330	   H2←CVXSTR(LDB(POINT(12,I,23)) LSH 24);
02335	   IF EQU(H1,H2) THEN BEGIN 
02340		OUTSTR(CRLF&"Old HEADER version, refuse to learn");
02345	     HCOUNT←999;   PREHINT←"NU"; RETURN("NU");  END;
02350	
02355	   IF H1≠0 THEN BEGIN
02360	     PREHINT←H1; HCOUNT←LDB(POINT(12,I,35));
02365	     HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; HINCNT←HINCNT+1; 
02370	     RETURN(PREHINT); DONE  END
02375	     ELSE BEGIN PREHINT←"NU"; HCOUNT←LDB(POINT(12,I,35));
02380	     HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE; END;
02385	  END "LATCH";
02390	 PREHINT←"NU"; RETURN(PREHINT); END "XX";
02395	END "HEADER";
02495	
03800	STDBRK(1);
03900	SETBREAK(14,"∃",NULL,"INS");
04000	
04100	FILEL←"LIST1.L0";
04200	FILEI←"TOO1.DAT[1,THO]"; M←8; INFLAG←0;
04300	CHAN1←1; CHAN2←2; CHAN3←3;  CHAN4←4; CHAN5←5;
04400	TABIN(INTOT);
04500	
04510	RETAIN←4;
04514	IF(OPT2←STRIN("Retention is now at "&CVS(RETAIN)&" (CR or 0 to 9)="))≠"" THEN
04518	  BEGIN RETAIN←CVD(OPT2); OUTSTR("Retention changed to "&CVS(RETAIN)&CRLF); END;
04522	IF RETAIN <9 THEN BEGIN  K←-RETAIN;
04526	FOR I←10+INTOT*74 STEP 74 UNTIL TABSIZ-64 DO BEGIN
04530	 IF TABLES[I-9]=0 THEN DONE;
04534	 IF LDB(POINT(1,TABLES[I-9],5))=0 THEN
04538	  FOR J←0 STEP 1 UNTIL 63 DO
04542	   TABLES[J]←TABLES[J]-((TABLES[J] LSH K ) LAND MASKP[RETAIN]) ELSE
04546	  FOR J←0 STEP 1 UNTIL 63 DO BEGIN
04550	   TABLES[J]←TABLES[J]-((TABLES[J] LSH K ) LAND MASKQ1[RETAIN]);
04554	   TABLES[J+74]←TABLES[J+74]-((TABLES[J+74] LSH K ) LAND MASKQ2[RETAIN]);
04558	   I←I+74;
04562	  END; END; END;
04570	
05510	FILSTR←STRIN("Ripple learn break-point list (STFILE.TMP) =");
05520	IF FILSTR="" THEN FILSTR←"STFILE.TMP";
05530	CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,3500,BRK,EOFB);
05540	LOOKUP(CHAN5,FILSTR,ER);
05550	WHILE ER DO BEGIN OUTSTR(CRLF&"Can not find "&FILSTR&
05560	     " File = ");
05570	  LOOKUP(CHAN5,FILSTR←INCHWL,ER); END;
05580	SNAMES←INPUT(CHAN5,14);
05590	SNAME←SCAN(SNAMES,1,J);
05595	IF SNAME="BEGIN" THEN STX←0 ELSE BEGIN
05600	FOR I←INTOT STEP 1 UNTIL 125 DO BEGIN
05610	  IF LIST[I]=CVSIX(SNAME) THEN DONE;
05620	END;
05640	STX←I*74; END;  EOFB←0;
05650	
05660	FILEL←STRIN("Data file list (LNFILE.TMP) = ");
05670	IF FILEL="" THEN FILEL←"LNFILE.TMP";
05680	START:
05690	WHILE EOFB=0 DO BEGIN "RIPPLE"
05700	IF SNAME="END" THEN DONE;
05710	CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,3500,BRK,EOFA);
05720	LOOKUP(CHAN5,FILEL,ER); WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find "&FILEL&
05730	" File = "); LOOKUP(CHAN5,FILEL←INCHWL,ER); END;  EOFA←0;
05740	 M←8; N←2↑M;  NF←2*N;
05750	
05760	FILLST←INPUT(CHAN5,14); EOFA←0;
05770	
05780	OUTSTR(CRLF&"Ripple learn starting with "&SNAME&" up to ");
05790	STXX←STX; SNAME←SCAN(SNAMES,1,J);
05800	OUTSTR(SNAME&CRLF);
05810	IF SNAME="" THEN DONE;
05820	  FOR I←INTOT STEP 1 UNTIL 125 DO BEGIN
05830	    IF LIST[I]=CVSIX(SNAME) THEN DONE; END;
05840	STX←I*74;
05850	OUTSTR("I="&CVS(I)&" SNAME="&CVXSTR(LIST[I])&CRLF);
05860	RL←0;
05870	
05880	
05890	WHILE EOFA=0 DO BEGIN "LISTREAD"
05900	HINDEX←21; HCOUNT←HINCNT←0;
05910	FILEI←SCAN(FILLST,1,J);
05920	IF FILEI="" THEN DONE;
05930	
05940		CLOSE(CHAN4);
05950	OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
05960	LOOKUP(CHAN4,FILEI,0);
05970	IF EOF≠0 THEN DONE;
05980	ARRYIN(CHAN4,LFILE[0],'200);	⊂ Input header;
05990	SEGTOT←(LFILE[0]*6)%N;
06000	OUTSTR(FILEI&" "&CVS(SEGTOT)&" seg. ");
06010	ARRYIN(CHAN4,INDATA[0],SEGTOT*4);
06020	CLOSE(CHAN4);
06030	BPT←POINT(6,INDATA[0],-1);
06040	HINDEX←21; HCOUNT←HINCNT←0;
06050	
06060	FOR SEGC←1 STEP 1 UNTIL SEGTOT DO BEGIN
06070	ZZ:  READ1←HEADER;
06080	  J←CVSIX(READ1);
06090	  FOR I←0 STEP 1 UNTIL 63 DO BEGIN   IF PHLIST[I]=0 THEN BEGIN
06100	    OUTSTR("Hint not identified for segment = "&READ1&"   " &CVS(SEGC)&CRLF);DONE END;
06110	    IF PHLIST[I]=J THEN BEGIN HINT←H←I;TABLES[2]←HLIST[I] ; DONE ; END;
06120	END;
06130	
06140	FOR P←0 STEP 1 UNTIL 23 DO  INDAT[P]←ILDB(BPT);
06150	ZZZZ:  SIG(P);
06160	ZZZ:	END;
06170	
06180	OUTSTR(CVS(HINCNT)&" hints . ");
06190	IF RL=0 THEN RL←1 ELSE BEGIN RL←0; OUTSTR(CRLF); END;
06200	IF EOFA≠0 THEN DONE;
06210	END "LISTREAD";
06220	⊂ REMOVE TEMPORARILY UPDATE;
06230	TABOUT;
06240	OUTSTR("Tables saved"&CRLF);
06250	
06260	END "RIPPLE";
06270	
06280	END "SAY";